﻿<%
'
' 网站样式，外部可以直接引用
' 要求：共同属性写入底层，这部分只是用于展现
' 函数命名：兼容旧系统,暂时没有统一


'检测用户能否发帖,管理帖子等
'刚注册30分钟内不能发帖，服刑期也不能发帖
Sub checkUserPost
	Dim regTime,life,uid
	uid = user_array(0)
	'检测用户是否在服刑
	checkUserStatus()
	'论坛开始很少帖，用户量少时不作限制，而且不少站长会注册掉前面的ID做系统保留
	If uid<100 Then Exit Sub
	regTime = user_array(5)
	life = hu_dateDiff(regTime,"n")
	If life>-30 Then rupt "错误","为了提高论坛的秩序，新注册的用户30分钟内不能发帖！"
End Sub

'检测用户是否在服刑
Sub checkUserStatus
	Dim uid,uStatus
	uid = user_array(0)
	If uid=0 Then Exit Sub
	uStatus=user_array(4)
	If ifStatusNormal(uStatus)=False Then
		rupt "错误", "你正在狱中服刑，暂时完成不了该操作<br/>"&hu.url("bbs_prison.asp?a=1","申请出狱")&" "&hu.url("bbs_user.asp","用户中心")
	End If
End Sub

'返回升级需要的经验
Function getExperienceByLevel(num)
	Dim level_,exp_
	level_=CStr(bbsLevel)
	Select Case level_
	Case "2"
		exp_ = num*(50+num*num+num)
	Case "3"
		exp_ = int(1.2^num) + num * (50+num*num)
	Case Else
		exp_ = num*(50+num)
	End Select
	getExperienceByLevel=exp_
End Function

'生成用户称号的性别
Function getTitleSex(sex)
	Select Case sex
		Case 1:getTitleSex="流浪汉"
		Case 2:getTitleSex="天涯女"
	End Select
End Function

'生成用户称号
' 称号：
' 路人，性别没有填
' 流浪汉，天涯女，地址没有填
' 大叔，大姐，生日没有填，或生日不在有效范围
' 帅哥，美女
' 美男，仙女（飞升级别）
' 坏人（管理员加黑）
'
' 贫困潦倒，没有钱，级别低的
' 两袖清风，没有钱，级别高的
' 闲云野鹤，没有钱，级别非常高的
' 财大气粗，有钱，级别低的
' 富甲一方，有钱，级别高的
' 富可敌国，很有钱，级别很高的
'
' 懒惰，发帖少
' 匆忙，发帖中，备注没有填
' 积极，发帖中
' 活跃，发帖多
'
' 扎进花海的美男，很有钱，级别很高的，发帖多的
' 堕入凡尘的仙女，很有钱，级别很高的，发帖多的
Function getUserTitle(sex,birth,city,topic,remark,money,level,status)
	Dim titleBase,titleDefault,titleSecond,years
	If status=3 Then
		titleBase = "坏人"
	Else
		If sex=0 Then
			titleBase="路人"
		Else
			If city&""="" Then
				titleBase=getTitleSex(sex)
			Else
				If birth&""="" Then
					titleBase=getTitleSex(sex)
				Else
					years = hu_dateDiff(birth, "yyyy")
					If years<-40 Or years>=5 Then
						titleBase=getTitleSex(sex)
					Else
						If topic>200 And money>5000 And level>40 Then
							If sex=1 Then
								getUserTitle="扎进花海的美男"
							Else
								getUserTitle="堕入凡尘的仙女"
							End If
							Exit Function
						End If
						If sex=1 Then
							titleBase="帅哥"
						Else
							titleBase="美女"
						End If
					End If
				End If
			End If
		End If
	End If
	Select Case True
		Case topic<20
			titleDefault="懒惰"
		Case topic<100
			If remark&""<>"" Then
				titleDefault="积极"
			Else
				titleDefault="匆忙"
			End If
		Case Else
			titleDefault="活跃"
	End Select
	If money<5000 Then
		Select Case True
		Case level<10
			titleSecond="贫困潦倒"
		Case level<30
			titleSecond="两袖清风"
		Case Else
			titleSecond="闲云野鹤"
		End Select
	Else
		Select Case True
		Case level<20
			titleSecond="财大气粗"
		Case level<40
			titleSecond="富甲一方"
		Case Else
			titleSecond="富可敌国"
		End Select
	End If
	getUserTitle=titleDefault&","&titleSecond&"的"&titleBase
End Function

'URL加密
Function urlEncode(url)
	url=Trim(url)
	If url="" Then urlEncode="":Exit Function
	url=Replace(url,"/","@i@")
	url=Replace(url,"&","@a@")
	url=Replace(url,"?","@q@")
	url=Replace(url,bbsSid,bbsSid&"1")'删除会话
	url=Replace(url,"=","@e@")
	urlEncode=url
End Function

'URL解密
Function urlDecode(url)
	url=Trim(url)
	If url="" Then urlDecode="":Exit Function
	url=Replace(url,"@i@","/")
	url=Replace(url,"@a@","&")
	url=Replace(url,"@q@","?")
	url=Replace(url,bbsSid,bbsSid&"1")'删除会话
	url=Replace(url,"@e@","=")
	urlDecode=url
End Function

'格式化文件大小
Function forFileSize(size)
	If Not ifNum(size) Then size=0
	Select Case true
		Case size<1024
			size=size&" B"
		Case size<1048576
			size=Round((size/1024),2)&" KB"
		Case size<1073741824
			size=Round((size/1024/1024),2)&" MB"
		Case else
			size=Round((size/1024/1024/1024),2)&" GB"
	End Select
	forFileSize=size
End Function

'格式化时间,num:多少秒,将格式为n秒或n分,n时,n天前
Function forTimeDiff(num)
	If Not ifNum(num) Then num=0
	Select Case true
		Case num<60
			num=num&"秒"
		Case num<3600
			num=int(num/60)&"分钟"
		Case num<86400
			num=int(num/3600)&"小时"
		Case num<604800
			num=int(num/86400)&"天"
		Case num<2592000
			num=int(num/604800)&"周"
		Case num<31536000
			num=int(num/2592000)&"个月"
		Case Else
			num=int(num/31536000)&"年"
	End Select
	forTimeDiff=num
End Function

'将时间与当前时间比较,获取n秒前,或这n分钟前等
Function getDiffFromNow(str)
	If Not IsDate(str) Then Exit Function
	getDiffFromNow=forTimeDiff(DateDiff("s", str, time_now))&"前"
End Function

'简单问候语
Function getHello()
	Dim newtime
	newtime=time_time
	If newtime < #06:00:00# And newtime >= #00:30:00# Then
		getHello="凌晨好！"
	ElseIf newtime < #09:00:00# And newtime >= #06:00:00# Then
		getHello="早上好！"
	ElseIf newtime < #11:30:00# And newtime >= #09:00:00# Then
		getHello="上午好！"
	ElseIf newtime < #12:30:00# And newtime >= #11:30:00# Then
		getHello="中午好！"
	ElseIf newtime < #18:00:00# And newtime >= #12:30:00# Then
		getHello="下午好！"
	ElseIf newtime < #20:00:00# And newtime >= #18:00:00# Then
		getHello="傍晚好！"
	ElseIf newtime < #23:30:00# And newtime >= #20:00:00# Then
		getHello="晚上好！"
	Else
		getHello="午夜好！"
	End If
End Function

'完整问候语
Function getfavor()
	Dim newtime,newmon,newday
	newtime = time_time:newmon = month(time_now):newday = day(time_now)
	If newtime < #06:00:00# And newtime >= #04:00:00# Then
		getfavor=""&newmon&"月"&newday&"日"&" "&"凌晨好！"
	ElseIf newtime < #09:00:00# And newtime >= #06:00:00# Then
		getfavor=""&newmon&"月"&newday&"日"&" "&"早上好！"
	ElseIf newtime < #11:30:00# And newtime >= #09:00:00# Then
		getfavor=""&newmon&"月"&newday&"日"&" "&"上午好！"
	ElseIf newtime < #12:30:00# And newtime >= #11:30:00# Then
		getfavor=""&newmon&"月"&newday&"日"&" "&"午饭时间到啦。"
	ElseIf newtime < #18:00:00# And newtime >= #12:30:00# Then
		getfavor=""&newmon&"月"&newday&"日"&" "&"下午好！"
	ElseIf newtime < #19:30:00# And newtime >= #18:00:00# Then
		getfavor=""&newmon&"月"&newday&"日"&" "&"晚饭时间到啦。"
	ElseIf newtime < #23:30:00# And newtime >= #19:30:00# Then
		getfavor=""&newmon&"月"&newday&"日"&" "&"晚上好！"
	Else
		getfavor=""&newmon&"月"&newday&"日"&" "&"夜深注意休息。"
	End If
End Function

'统一时间 2008.8.8 20:08
Function fordate(str)
	fordate=hu_dateFormat(str,"y.m.d h:i")
End Function

'统一时间 8-8 20:08
Function fordate2(str)
	fordate2=hu_dateFormat(str,"m-d h:i")
End Function

'时间比较
Function getDiff(day,str)
	Dim newday
	newday = hu_dateDiff(day,"d")
	If newday="" Or IsNumeric(newday)=False Then Exit Function
	If newday>0 Then
		getDiff = "距" & str & "还有" & newday & "天"
	Elseif newday=0 Then
		getDiff = "今天是"& str
	Else
		getDiff = str & "已过了" & newday*-1 & "天"
	End If
End Function

'计算岁数
Function getAge(day)
	Dim newday
	newday = hu_dateDiff(day,"yyyy")
	If Not IsNumeric(newday) Then Exit Function
	getAge = newday*-1
End Function

'检测网站升级
Function checkUpdate
	If adminUpdate>0 Then
		Dim tmp_
		If adminUpdate > 24 Then
			tmp_ = Int(adminUpdate / 24) &"天"
		Else
			tmp_ = adminUpdate &"小时"
		End If
		rupt "网站升级", "很抱歉，网站升级中，预计"&tmp_&"后恢复，请稍后再访问.."
	End If
End Function

'会员签名 显示控制 (信息过滤,同时方便以后vip支持ubb)
Function getUserRemark(str)
	str=Trim(str)
	If hu_isNull(str) Then
		getUserRemark="这家伙很懒,什么都没留下"
	Else
		getUserRemark=noubb(str)
	End If
End Function

'判断性别
Function getSex(sex)
	getSex = "保密"
	Select Case sex
		Case 0:getSex="保密"
		Case 1:getSex="男"
		Case 2:getSex="女"
	End Select
End Function

'判断性别
Function getBbsSex(sex)
	getBbsSex = "保密"
	Select Case sex
		Case 0:getBbsSex="保密"
		Case 1:getBbsSex="帅哥"
		Case 2:getBbsSex="美女"
	End Select
End Function

'判断用户的状态
Function getStatus(status)
	getStatus = "账户异常"
	Select Case status
		Case 0:getStatus="正常使用"
		Case 3:getStatus="入狱服刑"
	End Select
End Function

'判断用户状态是否正常
Function ifUserNormal(id)
	ifUserNormal=ifStatusNormal(getUserStatus(id))
End Function

'判断状态是否正常
'status:0正常，3加黑，-1帐号异常
Function ifStatusNormal(status)
	ifStatusNormal=False
	Select Case int(status)
		Case 0:ifStatusNormal=True
	End Select
End Function

'搜索框
Function getSearchXml
	If hu_style Then
		getSearchXml="<form name=""index"" method=""post"" action="""&http_path&"search.asp"">"&_
		"<input type=""text"" name=""keyword"" title=""请输入关键词""/>"&_
		"<br/><select name=""a""><option value=""0"">文章</option><option value=""1"">帖子</option></select>"&_
		"<input type=""hidden"" name="""&bbsSid&""" value="""&sid&"""/>"&_
		"<input type=""hidden"" name=""sear"" value=""0""/>&nbsp;<input type=""submit"" value=""搜索""/></form>"&_
		"&nbsp;" & hu.url("search.asp","更多»")
	Else
		getSearchXml="<input type=""text"" name=""keyword"" value="""" title=""请输入关键词""/><br/>"&_
		"搜<anchor>文章<go href="""&http_path&"search.asp"" method=""post""><postfield name=""keyword"" value=""$(keyword)""/>"&_
		"<postfield name=""sear"" value=""0""/><postfield name="""&bbsSid&""" value="""&sid&"""/></go></anchor>"&_
		".<anchor>帖子<go href="""&http_path&"search.asp?a=1"" method=""post""><postfield name=""keyword"" value=""$(keyword)""/>"&_
		"<postfield name=""sear"" value=""0""/><postfield name="""&bbsSid&""" value="""&sid&"""/></go></anchor>"&_
		"." & hu.url("search.asp","»")
	End If
End Function

'群聊框
Function getWorldCommentXml
	If hu_style Then
		getWorldCommentXml="<form name=""dis"" action="""&http_path&"comment.asp"" method=""post"">"&_
			"<input type=""text"" name=""pl"" value="""" maxlength=""100"" style=""width:110px""/>"&_
			"<input type=""hidden"" name=""id"" value=""0""/><input type=""hidden"" name="""&bbsSid&""" value="""&sid&"""/>"&_
			"<input type=""submit"" value=""提交""/></form>"
	Else
		getWorldCommentXml="<input type=""text"" name=""pl"&Time_r&""" title=""输入内容"" value="""" maxlength=""100"" size=""16""/>"&_
		"<anchor title=""确定"">提交<go method=""post"" href="""&http_path&"comment.asp?id=0&amp;"&sid_str&""">"&_
		"<postfield name=""pl"" value=""$(pl"&Time_r&")""/></go></anchor>"
	End If
End Function

'检测是否登录
Sub checkLogin
	If Not iflogin Then
		rupt "页面出错","您还没有以会员身份登陆！<br/>" & hu.url("bbs_login.asp?_u="&back_url,"现在登录")&" "& hu.url("bbs_reg.asp?_u="&back_url,"还没注册？")&"<br/>"
	End If
End Sub

'检测是否有新信息
Function checkMsg
	Dim usrid,msgcount_,usrday,body_
	body_ = ""
	if wapReport=1 And aid<>"report" then body_ = body_ & showImg("board")&""&getReport
	usrid=user_array(0)
	If usrid >0 Then
		usrday=user_array(3)
		If usrday<>"" And bbsbirthday<>"" Then
			If Month(usrday)=Month(time_now) And Day(usrday)=Day(time_now) Then body_ = body_ & showImg("birth")&ubbcode(bbsbirthday) &"<br/>"
		End If
		msgcount_=getUserMsgCount(usrid)
		If msgcount_>0 Then
			body_ = body_ & showImg("msg")& hu.url("bbs_msgs.asp","你有("&msgcount_&")条新信息")&"<br/>"
			checkMsg=body_
			Exit Function
		End If
		'以后检测广播,逐渐淘汰公告模式
		msgcount_=getUserFriendApplyCount(usrid)
		If msgcount_>0 Then
			body_ = body_ & showImg("ring")& hu.url("bbs_friend.asp?a=1","你有("&msgcount_&")条好友请求")&"<br/>"
			checkMsg=body_
			Exit Function
		End If
		If Not ifSetSecret(usrid) Then
			body_ = body_ & showImg("ring")& hu.url("bbs_safe.asp","你还没有设置密保")&"<br/>"
			checkMsg=body_
			Exit Function
		End If
		If wapLogin=1 Then
			'会员中心-游戏中心
			If wapLogined<>"" Then body_ = body_ & ubbcode(wapLogined)&"<br/>"
			checkMsg=body_
			Exit Function
		End If
	Else
		If wapLogin=1 Then
			' body_ = body_ & hu.url("bbs_login.asp?_u="&back_url,"现在登录")&" "& hu.url("bbs_reg.asp?_u="&back_url,"还没注册？")&"<br/>"
			body_ = body_ & ubbcode(wapLogout)&"<br/>"
			checkMsg=body_
			Exit Function
		End If
	End If
	checkMsg=body_
End Function

'此检测为了实现sql语句的in(1,2,3,5)语法
Function checkStringForSqlInNum(str)
	Set re=New regexp
	' re.IgnoreCase =True
	re.Global=True
	re.Pattern="^\d+(,\d+)*$"
	checkStringForSqlInNum=re.Test(str)
	Set re=Nothing
End Function

'格式化逗号,转成英文逗号
Function forComma(str)
	str = Replace(str,"，",",")
	forComma = str
End Function

'双引号替换,用途:配置文件无法解析双引号
Function forQuote(str)
	str=Replace(str,"""","'")
	str=Replace(str,"<"&"%","")
	str=Replace(str,"%"&">","")
	str=Replace(str,"	","")
	str=Replace(str,Chr(13),"")
	str=Replace(str,Chr(10),"")
	forQuote=Trim(str)
End Function

'去除广告网址
Function noad(str)
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	re.Pattern="([0-9A-Za-z- ]+\.)+[A-Za-z ]{2,}"
	str=re.Replace(str,"***.**")
	Set re=Nothing
	noad=str
End Function

'标题和不使用ubb的内容nowml,后台编辑
Function nowml(str)
	If hu_isNull(str) Then Exit Function
	' str=Trim(str)
	str=hu_forShow(str)
	nowml=str
End Function

'标题和不使用ubb的内容noubb,前台显示
Function noubb(str)
	If hu_isNull(str) Then Exit Function
	' str=Trim(str)
	str=hu_forShow(str)
	str=changeWord(str)
	str=Replace(str,""," ")
	str=Replace(str,"&nbsp;"," ")
	noubb=str
End Function

'用于链接
Function noubburl(str)
	If hu_isNull(str) Then Exit Function
	str=Trim(str)
	str=hu_decode(str)
	str=changeWord(str)
	str=Replace(str,"&","&amp;")
	str=Replace(str,"&amp;amp;","&amp;")'勿删
	str=Replace(str,"<","")
	str=Replace(str,">","")
	str=Replace(str,"'","")
	str=Replace(str,"""","")
	str=Replace(str,"","")
	str=Replace(str,"&nbsp;","")
	str=Replace(str,"&#35;","#")
	str=Replace(str,"&#58;",":")
	str=Replace(str,"&#61;","=")
	str=Replace(str,"&#63;","?")
	str=Replace(str,"%","")
	noubburl=str
End Function

'用于链接
Function nourl(str)
	If hu_isNull(str) Then Exit Function
	str=Trim(str)
	str=hu_decode(str)
	str=changeWord(str)
	str=Replace(str,"&amp;","&")'勿删
	str=Replace(str,"&amp;","&")
	str=Replace(str,"<","")
	str=Replace(str,">","")
	str=Replace(str,"'","")
	str=Replace(str,"""","")
	str=Replace(str,"","")
	str=Replace(str,"&nbsp;","")
	str=Replace(str,"&#35;","#")
	str=Replace(str,"&#58;",":")
	str=Replace(str,"&#61;","=")
	str=Replace(str,"&#63;","?")
	str=Replace(str,"%","")
	nourl=str
End Function

'wml展示
Function wmlcode(str)
	If hu_isNull(str) Then Exit Function
	str=Replace(str,"[sid]",sid_str,1,-1,1)
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	If InStr(str, "[/wap")>0 Then
		re.Pattern="\[wap1\](.[^\[]*)\[\/wap1\]"
		If hu_style Then
			str=re.Replace(str,"")
		Else
			str=re.Replace(str,"$1")
		End If
		re.Pattern="\[wap2\](.[^\[]*)\[\/wap2\]"
		If hu_style Then
			str=re.Replace(str,"$1")
		Else
			str=re.Replace(str,"")
		End If
	End If
	Set re=Nothing
	wmlcode=str
End Function

'ubb展示
Function ubbcode(str)
	If hu_isNull(str) Then Exit Function
	Dim newstr,re,ma,m,strReg,strExp,userid,newurl_
	newstr=time_now
	userid=user_array(0)
	' str=Trim(str)
	str=hu_forShow(str)
	str=changeWord(str)
	str=Replace(str,Chr(13),"")
	str=Replace(str,Chr(10),"")
	str=Replace(str,"\\","<br/>")
	str=Replace(str,"""","&quot;")
	str=Replace(str,"&nbsp;"," ")
	str=Replace(str,"[br]","<br/>")
	If InStr(str, "]")>0 Then
		If hu_style Then
			str=Replace(str,"[gotop]","<a href='#top'><img src='images/top.gif' alt='top'/></a>")
		Else
			str=Replace(str,"[gotop]","")
		End If
		str=Replace(str,"[tab]","&nbsp;")
		str=Replace(str,"[date]",time_date)
		str=Replace(str,"[time]",time_time)
		str=Replace(str,"[now]",newstr)
		str=Replace(str,"[week]",WeekDayName(DatePart("w",newstr)))'星期几
		str=Replace(str,"[month]",Month(newstr))
		str=Replace(str,"[day]",Day(newstr))
		str=Replace(str,"[hello]",gethello)
		str=Replace(str,"[favor]",getfavor)
		str=Replace(str,"[wapname]",wapTitle)
		str=Replace(str,"[wapurl]",wapUrl)
		str=Replace(str,"[sid]","_b=1")
		str=Replace(str,"[username]",user_array(1))
		str=Replace(str,"[userid]",userid)
		If InStr(str, "[login]")>0 Then
			If userid>0 Then
				str=Replace(str,"[login]", hu.url("bbs_user.asp","会员中心"))
			Else
				str=Replace(str,"[login]", hu.url("bbs_login.asp?_u="&back_url,"登录")&"/"& hu.url("bbs_reg.asp?_u="&back_url,"注册"))
			End If
		End If
		If InStr(str, "[url_")>0 Then
			str=Replace(str,"[url_report]", "report.asp?_a=1")'与UI对应
			str=Replace(str,"[url_index]", "?aid=index")
			str=Replace(str,"[url_list]", "list.asp?_a=1")
			str=Replace(str,"[url_class]", "class.asp?_a=1")
			str=Replace(str,"[url_link]", "link.asp?_a=1")
			str=Replace(str,"[url_art]", "article.asp?_a=1")
			str=Replace(str,"[url_guest]", "guest.asp?_a=1")
			str=Replace(str,"[url_map]", "map.asp?_a=1")
			str=Replace(str,"[url_bookmark]", "bookmark.asp?_a=1")
			str=Replace(str,"[url_new]", "new.asp?_a=1")
			str=Replace(str,"[url_style]", "style.asp?_u="&back_url)
			str=Replace(str,"[url_login]", "bbs_login.asp?_u="&back_url)
			str=Replace(str,"[url_reg]", "bbs_reg.asp?_u="&back_url)
			str=Replace(str,"[url_topic]", "bbs_topic.asp?_a=1")
			str=Replace(str,"[url_user]", "bbs_user.asp?_a=1")
			str=Replace(str,"[url_msgs]", "bbs_msgs.asp?_a=1")
			str=Replace(str,"[url_posts]", "bbs_posts.asp?_a=1")
			str=Replace(str,"[url_replys]", "bbs_replys.asp?_a=1")
			str=Replace(str,"[url_essay]", "bbs_essay.asp?_a=1")
			str=Replace(str,"[url_mypost]", "bbs_mypost.asp?_a=1")
			str=Replace(str,"[url_myessay]", "bbs_myessay.asp?_a=1")
			str=Replace(str,"[url_online]", "bbs_online.asp?_a=1")
			str=Replace(str,"[url_discuss]", "discuss.asp?_a=1")
			str=Replace(str,"[url_search]", "search.asp?_a=1")
			str=Replace(str,"[url_friend]", "bbs_friend.asp?_a=1")
			str=Replace(str,"[url_users]", "bbs_users.asp?_a=1")
			str=Replace(str,"[url_sign]", "bbs_sign.asp?_a=1")
			str=Replace(str,"[url_visit]", "online.asp?_a=1")
			str=Replace(str,"[url_keep]", "bbs_keep.asp?_a=1")
		End If
		newstr=""
		newurl_=""
		Set re=new RegExp
		re.IgnoreCase =True
		re.Global=True
		str=Replace(str,"(","→↑↓←_hu_")
		str=Replace(str,")","→↓↑←_hu_")
		If InStr(str, "[/pic]")>0 Then
			re.Pattern="\[pic\](.[^\[]*)\[\/pic\]"
			If ifSusAspJpeg=True Then
				str=re.Replace(str,"<img src='img.asp?img=$1' alt='.'/><br/><a href='$1'>原图下载</a>")
			Else
				str=re.Replace(str,"<img src='$1' alt='.' width=""220""/><br/><a href='$1'>原图下载</a>")
			End If
		End If
		If InStr(str, "[/img]")>0 Then
			re.Pattern="\[img\](.[^\[]*)\[\/img\]"
			str=re.Replace(str,"<img src='$1' alt='.'/>")
			If InStr(str, "[img=")>0 Then
				re.Pattern="\[img=(.[^\]]*)\](.[^\[]*)\[\/img\]"
				str=re.Replace(str,"Url(""$2"",""<img src='$1' alt='.'/>"")")
				newurl_="Url"
			End If
		End If
		If InStr(str, "[/u]")>0 Then
			re.Pattern="\[u\](.[^\[]*)\[\/u\]"
			str=re.Replace(str,"<u>$1</u>")
		End If
		If InStr(str, "[/i]")>0 Then
			re.Pattern="\[i\](.[^\[]*)\[\/i\]"
			str=re.Replace(str,"<i>$1</i>")
		End If
		If InStr(str, "[/s]")>0 Then
			re.Pattern="\[s\](.[^\[]*)\[\/s\]"
			str=re.Replace(str,"<s>$1</s>")
		End If
		If InStr(str, "[/small]")>0 Then
			re.Pattern="\[small\](.[^\[]*)\[\/small\]"
			str=re.Replace(str,"<small>$1</small>")
		End If
		If InStr(str, "[/b]")>0 Then
			re.Pattern="\[b\](.[^\[]*)\[\/b\]"
			str=re.Replace(str,"<b>$1</b>")
		End If
		If InStr(str, "[/day]")>0 Then
			re.Pattern="\[day=(.[^\]]*)\](.[^\[]*)\[\/day\]"
			str=re.Replace(str,"Diff(""$1"",""$2"")")
			newstr=newstr& "Diff|"
		End If
		If InStr(str, "[/color]")>0 Then
			re.Pattern="\[color=(.[^\]]*)\](.[^\[]*)\[\/color\]"
			str=re.Replace(str,"<font color='$1'>$2</font>")
		End If
		If InStr(str, "[/bgsound]")>0 Then
			re.Pattern="\[bgsound](.[^\[]*)\[\/bgsound\]"
			str=re.Replace(str,"<bgsound src='$1' loop='-1' volume='50'/>")
		End If
		If InStr(str, "[/url]")>0 Then
			re.Pattern="\[url\](.[^\[]*)\[\/url\]"
			str=re.Replace(str,"Url(""$1"",""$1"")")
			re.Pattern="\[url=(.[^\]]*)\](.[^\[]*)\[\/url\]"
			str=re.Replace(str,"Url(""$1"",""$2"")")
			' newstr=newstr& "Url|"
			newurl_="Url"
		End If
		If InStr(str, "[link")>0 Then
			re.Pattern="\[link([^\]]*)\]"
			str=re.Replace(str,"Link(""$1"")")
			newstr=newstr& "Link|"
		End If
		If InStr(str, "[online")>0 Then
			re.Pattern="\[online([^\]]*)\]"
			str=re.Replace(str,"Online(""$1"")")
			newstr=newstr& "Online|"
		End If
		If InStr(str, "[visit")>0 Then
			re.Pattern="\[visit([^\]]*)\]"
			str=re.Replace(str,"Visit(""$1"")")
			newstr=newstr& "Visit|"
		End If
		If InStr(str, "[/m")>0 Then
			re.Pattern="\[m1\](.[^\[]*)\[\/m1\]"
			str=re.Replace(str,"<marquee>$1</marquee>")
			re.Pattern="\[m2\](.[^\[]*)\[\/m2\]"
			str=re.Replace(str,"<marquee behavior='alternate' scrollamount='2'>$1</marquee>")
		End If
		If InStr(str, "[/rnd]")>0 Then
			re.Pattern="\[rnd\](.[^\[]*)\[\/rnd\]"
			str=re.Replace(str,"RndStr(""$1"",""|"")")
			re.Pattern="\[rnd=(.[^\]]*)\](.[^\[]*)\[\/rnd\]"
			str=re.Replace(str,"RndStr(""$2"",""$1"")")
			newstr=newstr& "RndStr|"
		End If
		If InStr(str, "[/hide]")>0 Then
			re.Pattern="\[hide\](.[^\[]*)\[\/hide\]"
			If userid>0 Then
				str=re.Replace(str,"$1")
			Else
				str=re.Replace(str,"〖内容隐藏,"&hu.url("bbs_login.asp?_u="&back_url,"登录")&"显示〗")
			End If
		End If
		If InStr(str, "[/center]")>0 Then
			re.Pattern="\[center\](.[^\[]*)\[\/center\]"
			str=re.Replace(str,"<p align='center'>$1</p>")
		End If
		If InStr(str, "[/nav]")>0 Then
			re.Pattern="\[nav\](.[^\[]*)\[\/nav\]"
			str=re.Replace(str,"[div=nav]$1[/div]")
		End If
		If InStr(str, "[/div]")>0 Then
			re.Pattern="\[div=(.[^\]]*)\](.[^\[]*)\[\/div\]"
			If hu_style Then
				str=re.Replace(str,"<div class='$1'>$2</div>")
			Else
				str=re.Replace(str,"$2<br/>")
			End If
		End If
		If InStr(str, "[/wap")>0 Then
			re.Pattern="\[wap1\](.[^\[]*)\[\/wap1\]"
			If hu_style Then
				str=re.Replace(str,"")
			Else
				str=re.Replace(str,"$1")
			End If
			re.Pattern="\[wap2\](.[^\[]*)\[\/wap2\]"
			If hu_style Then
				str=re.Replace(str,"$1")
			Else
				str=re.Replace(str,"")
			End If
		End If
		If newurl_<>"" Then
			re.Pattern="Url\(.[^\)\(]*\)"
			Set ma=re.Execute(str)
			For Each m In ma
			strReg=m.Value
			strReg=Replace(strReg, chr(13)&chr(10), "")
			Execute("strExp=get"&strReg)
			str=Replace(str,strReg,strExp)
			Next
		End If
		Set ma=Nothing
		If Len(newstr)>0 Then
			newstr=Left(newstr, Len(newstr)-1)
			re.Pattern="("&newstr&")\([^\)\(]*\)"
			Set ma=re.Execute(str)
			For Each m In ma
			strReg=m.Value
			strReg=Replace(strReg, chr(13)&chr(10), "")
			Execute("strExp=get"&strReg)
			str=Replace(str,strReg,strExp)
			Next
			Set ma=Nothing
		End If
		str=Replace(str,"→↑↓←_hu_","(")
		str=Replace(str,"→↓↑←_hu_",")")
		Set re=Nothing
	End If
	ubbcode=str
End Function

'去掉所有的UBB内容,目前用于html描述,微博
Function noUbbCode(str)
	If hu_isNull(str) Then Exit Function
	str=Replace(str,"&","&amp;")
	str=Replace(str,"\\","")
	str=Replace(str,chr(13),"")
	str=Replace(str,chr(10),"")
	str=Replace(str,"<","&lt;")
	str=Replace(str,">","&gt;")
	str=Replace(str,"""","&quot;")
	str=Replace(str,"'","&apos;")
	Set re=new RegExp
	re.IgnoreCase=True
	re.Global=True
	re.Pattern="\[(\/)?[^\]]+\]"
	str=re.Replace(str,"")
	Set re=Nothing
	noUbbCode=str
End Function

'论坛帖子ubb展示
Function bbsubb(str)
	If hu_isNull(str) Then Exit Function
	Dim newstr,re,userid
	userid=user_array(0)
	newstr=time_now
	' str=Trim(str)
	str=hu_forShow(str)
	str=changeWord(str)
	str=Replace(str,"&nbsp;"," ")
	str=Replace(str,"[br]","<br/>")
	str=Replace(str,"[sid]",sid_str)
	str=Replace(str,"[username]",user_array(1))
	Set re=new RegExp
	re.IgnoreCase=True
	re.Global=True
	If InStr(str, "\")>0 Then
		str=Replace(str,"\\","<br/>")
		str = hu_ubbToFaceImage(re,str)
	End If
	If InStr(str, "[/image]")>0 Then
		re.Pattern="\[image\](.[^\[]*)\[\/image\]"
		str=re.Replace(str,"<img src='$1' alt='.'/>")
	End If
	If InStr(str, "[/img]")>0 Then
		' str=re.Replace(str,"<img src='img.asp?img=$1' alt='.'/><br/><a href='$1'>原图下载</a>")
		If ifSusAspJpeg=True Then
			re.Pattern="\[img\](.[^\[]*)\[\/img\]"
			str=re.Replace(str,"<img src='img.asp?img=$1' alt='.'/><br/><a href='$1'>原图下载</a>")
			re.Pattern="\[img=(.[^\]]*)\](.[^\[]*)\[\/img\]"
			str=re.Replace(str,"<a href='"&http_path&"bbs_urls.asp?url=$2'><img src='img.asp?img=$1' alt='.'/></a>")
		Else
			re.Pattern="\[img\](.[^\[]*)\[\/img\]"
			str=re.Replace(str,"<img src='$1' alt='.' width=""220""/><br/><a href='$1'>原图下载</a>")
			re.Pattern="\[img=(.[^\]]*)\](.[^\[]*)\[\/img\]"
			str=re.Replace(str,"<a href='"&http_path&"bbs_urls.asp?url=$2'><img src='$1' alt='.' width=""220""/></a>")
		End If		
	End If
	re.Pattern="\[u\](.[^\[]*)\[\/u\]"
	str=re.Replace(str,"<u>$1</u>")
	re.Pattern="\[i\](.[^\[]*)\[\/i\]"
	str=re.Replace(str,"<i>$1</i>")
	re.Pattern="\[s\](.[^\[]*)\[\/s\]"
	str=re.Replace(str,"<s>$1</s>")
	re.Pattern="\[b\](.[^\[]*)\[\/b\]"
	str=re.Replace(str,"<b>$1</b>")
	re.Pattern="\[color=(.[^\]]*)\](.[^\[]*)\[\/color\]"
	str=re.Replace(str,"<font color=""$1"">$2</font>")
	re.Pattern="\[url\](.[^\[]*)\[\/url\]"
	str=re.Replace(str,"<a href='"&http_path&"bbs_urls.asp?url=$1'>$1</a>")
	re.Pattern="\[url=(.[^\]]*)\](.[^\[]*)\[\/url\]"
	str=re.Replace(str,"<a href='"&http_path&"bbs_urls.asp?url=$1'>$2</a>")
	If InStr(str, "[/hide]")>0 Then
		re.Pattern="\[hide\](.[^\[]*)\[\/hide\]"
		If userid>0 Then
			str=re.Replace(str,"$1")
		Else
			str=re.Replace(str,"〖内容隐藏,"&hu.url("bbs_login.asp?_u="&back_url,"登录")&"显示〗")
		End If
	End If
	Set re=Nothing
	bbsubb=str
End Function

'论坛留言ubb展示
Function replyUbb(str)
	Dim re
	If hu_isNull(str) Then Exit Function
	' str=Trim(str)
	str=hu_forShow(str)
	str=changeWord(str)
	Set re=new RegExp
	re.IgnoreCase=True
	re.Global=True
	str = hu_ubbToFaceImage(re, str)
	re.Pattern="\[div([^\]]*)\](.[^\[]*)\[\/div\]"
	str=re.Replace(str,"[ div$1]$2[ /div]")
	Set re=Nothing
	replyUbb = str
End Function

'论坛留言ubb展示
Function discussUbb(str)
	Dim re
	If hu_isNull(str) Then Exit Function
	' str=Trim(str)
	str=hu_forShow(str)
	str=changeWord(str)
	Set re=new RegExp
	re.IgnoreCase=True
	re.Global=True
	str = hu_ubbToFaceImage(re, str)
	re.Pattern="\[div([^\]]*)\](.[^\[]*)\[\/div\]"
	str=re.Replace(str,"[ div$1]$2[ /div]")
	Set re=Nothing
	discussUbb = str
End Function

'论坛回帖ubb展示 其中,re = new RegExp
Function hu_ubbToFaceImage(re, str)
	'为提高效率,不检测意外赋值
	re.Pattern="\\([a-z]{2})"
	str=re.Replace(str, "<img src='"&http_path & "images/face/$1.gif' alt='$1'/>")
	hu_ubbToFaceImage=str
End Function

'实现兼容的1.0和2.0兼容的UBB
Function comUbb(str)
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	If InStr(str, "[/div]")>0 Then
		re.Pattern="\[div=([^\[\]]*)\]"
		If hu_style Then
			str=re.Replace(str,"<div class='$1'>")
			str = Replace(str, "[/div]","</div>")
		Else
			str=re.Replace(str,"")
			str = Replace(str, "[/div]","<br/>")
		End If
	End If
	If InStr(str, "[/span]")>0 Then
		re.Pattern="\[span=([^\]]*)\]"
		If hu_style Then
			str=re.Replace(str,"<span class='$1'>")
			str = Replace(str, "[/span]","</span>")
		Else
			str=re.Replace(str,"")
			str = Replace(str, "[/span]","")
		End If
	End If
	Set re=Nothing
	comUbb=str
End Function

'网页头部
Sub getHead(str, ver)
	Select Case ver
	Case 1
		Response.ContentType = "text/vnd.wap.wml; charset=utf-8"
		w "<?xml version=""1.0"" encoding=""utf-8""?>" &_
			"<!DOCTYPE wml PUBLIC ""-//WAPFORUM//DTD WML 1.1//EN"" ""http://www.wapforum.org/DTD/wml_1.1.xml"">" &_
			"<wml><head>" & str
	Case 2
		Response.ContentType = "text/html; charset=utf-8"
		w "<?xml version=""1.0"" encoding=""utf-8""?>" &_
			"<!DOCTYPE html PUBLIC ""-//WAPFORUM//DTD XHTML Mobile 1.0//EN"" ""http://www.wapforum.org/DTD/xhtml-mobile10.dtd"">" &_
			"<html xmlns=""http://www.w3.org/1999/xhtml""><head>" &_
			"<meta http-equiv=""Content-Type"" content=""text/html;charset=utf-8""/>" & str
	Case 0
		Response.ContentType = "text/html; charset=utf-8"
		w "<?xml version=""1.0"" encoding=""utf-8""?>" &_
			"<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"">" &_
			"<html xmlns=""http://www.w3.org/1999/xhtml""><head>" &_
			"<meta http-equiv=""Content-Type"" content=""text/html;charset=utf-8""/>"& str
	End Select
End Sub

' wap1.0翻页菜单
Function showPage(aim, obj, current, count)
	Dim body_,tmpUrl,tmpMenu,paramsArr,paramArr,i,j
	body_ = ""
	If hu_style Then
		aim = http_path & aim
		If obj="" Then
			tmpUrl = aim &"?" & bbsSid &"="& sid &"&amp;"
			tmpMenu = tmpMenu & "<input type=""hidden"" name="""&bbsSid&""" value="""&sid&"""/>"
		Else
			paramsArr = Split(obj,",")
			For i=LBound(paramsArr) To UBound(paramsArr)
				paramArr = Split(paramsArr(i),":")
				tmpUrl = tmpUrl & paramArr(0) & "=" & paramArr(1) & "&amp;"
				tmpMenu = tmpMenu & "<input type=""hidden"" name="""&paramArr(0)&""" value="""&paramArr(1)&"""/>"
			Next
			tmpUrl = aim &"?"& tmpUrl & bbsSid &"="&sid &"&amp;"
			tmpMenu = tmpMenu & "<input type=""hidden"" name="""&bbsSid&""" value="""&sid&"""/>"
		End If
		If current >1 Then body_ = "<a href="""&tmpUrl&"page=1"">首页</a> "
		If current < count Then body_ = body_ & "<a href="""&tmpUrl&"page="&current+1&""">下页</a> "
		If current >1 Then body_ = body_ & "<a href="""&tmpUrl&"page="&current-1&""">上页</a> "
		If current < count Then body_ = body_ & "<a href="""&tmpUrl&"page="&count&""">末页</a>"
		If count >1 Then body_ = body_ & "(<b>"&current&"</b>/"&count&")<br/><form name=""page"" action="""&aim&""" method=""get"">"&_
			"第<input name=""page"" style=""width:25px"" maxlength=""2""/>页" & tmpMenu & " <input type=""submit"" value=""翻页""/></form>"
	Else
		aim = http_path & aim
		If obj="" Then
			tmpUrl = aim &"?" & bbsSid & "=" & sid
		Else
			tmpUrl = aim &"?"& Replace(Replace(obj,",","&amp;"),":","=") &"&amp;"&bbsSid&"="&sid
		End If
		If current >1 Then body_ = "<a href="""&tmpUrl&"&amp;page=1"">首页</a> "
		If current < count Then body_ = body_ & "<a href="""&tmpUrl&"&amp;page="&current+1&""">下页</a> "
		If current >1 Then body_ = body_ & "<a href="""&tmpUrl&"&amp;page="&current-1&""">上页</a> "
		If current < count Then body_ = body_ & "<a href="""&tmpUrl&"&amp;page="&count&""">末页</a>"
		If count >1 Then body_ = body_ & "(<b>"&current&"</b>/"&count&")<br/>第<input name=""i"&time_r&""" type=""text"" format=""*N"" "&_
			"emptyok=""true"" size=""2"" value="""" maxlength=""2""/>页<anchor> 翻页<go href="""&tmpUrl&""" accept-charset=""utf-8"">"&_
			"<postfield name=""page"" value=""$(i"&time_r&")""/></go></anchor><br/>"
	End If
	showPage = body_
End Function

'页面的主函数
Sub main
	'等待页面重写
	hu.body = "No Main Function"
	Set hu = Nothing
End Sub

'中断输出
Sub rupt(title,content)
	hu.title = title
	hu.body = content & "<br/>" & ubbcode(wapLast)
	Set hu = Nothing
End Sub

'生成链接
Function getUrl(src, name)
	getUrl = hu.url(src, name)
End Function
%>